home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / HyperCard Related / XCMDs & XFCNs / PopUpMenu 1.1 / MenuTools.p next >
Encoding:
Text File  |  1991-06-05  |  1.6 KB  |  79 lines  |  [TEXT/MPS ]
  1. {
  2.     File: MenuTools.p
  3.  
  4.     This pascal unit contains a few general routines to perform popup menus.
  5.  
  6. }
  7.  
  8.  
  9. UNIT MenuTools;
  10.  
  11. INTERFACE
  12.  
  13. USES Types, ToolIntf;
  14.  
  15.         
  16.     PROCEDURE AppendAllMenuItems(Menu: MenuHandle; MenuItems: Str255);
  17.  
  18.     FUNCTION DoPopUpMenu(MenuID: INTEGER; MenuItems: Str255; CheckedItem: LONGINT;
  19.                         Top: LONGINT; Left: LONGINT): LONGINT;
  20.  
  21.  
  22. IMPLEMENTATION
  23.     
  24.     PROCEDURE AppendAllMenuItems(Menu: MenuHandle; MenuItems: Str255);
  25.  
  26.     VAR
  27.         Index:        Integer;
  28.     BEGIN
  29.                             
  30.         FOR Index := 1 TO length(MenuItems) DO
  31.             IF MenuItems[Index] = ',' THEN
  32.                 MenuItems[Index] := ';';
  33.  
  34.         AppendMenu(Menu, MenuItems);
  35.  
  36.     END { AppendAllMenuItems } ;
  37.  
  38.     FUNCTION DoPopUpMenu(MenuID: INTEGER; MenuItems: Str255; CheckedItem: LONGINT;
  39.                         Top: LONGINT; Left: LONGINT): LONGINT;
  40.     VAR
  41.     Menu:                MenuHandle;
  42.  
  43.     BEGIN
  44.         
  45.         { Create the PopUp menu }
  46.         Menu := NewMenu(MenuID, '');
  47.         AppendAllMenuItems(Menu, MenuItems);
  48.         CheckItem(Menu, CheckedItem, true);
  49.         InsertMenu(Menu, - 1);
  50.  
  51.         { Get Menu Selection }
  52.         DoPopUpMenu := PopUpMenuSelect(Menu, Top, Left, CheckedItem);
  53.  
  54.         { Tidy up }
  55.         DeleteMenu(MenuID);
  56.         DisposeMenu(Menu);
  57.  
  58.     END; {DoPopUpMenu}
  59.     
  60.     
  61.     { THIS HAS A BUG. DON’T USE IT FOR ANYTHING }
  62.     PROCEDURE CStringToPString(CString: Ptr; VAR PString: Str255);
  63.     TYPE
  64.         CStr =            PACKED ARRAY [1..32000] of CHAR;
  65.         CStPtr =        ^CStr;
  66.     VAR
  67.         Index:            INTEGER;
  68.         FakeStringPtr:    StringPtr;
  69.     BEGIN
  70.         FakeStringPtr := StringPtr(CString);
  71.         FOR Index := 1 TO 255 DO
  72.         BEGIN
  73.             IF  (FakeStringPtr^[Index - 1] = chr(0)) THEN Leave;        
  74.             PString[Index] := FakeStringPtr^[Index - 1];
  75.         END;
  76.         PString[0] := chr(Index);
  77.     END; { CStringToPString }
  78.         
  79. END. {Unit}